home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / title.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-21  |  7.9 KB  |  247 lines
  1. /* title.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  26.         rstats[50];
  27.     integer iwidth, lwidth, nopage;
  28. } miscel_;
  29.  
  30. #define miscel_1 miscel_
  31.  
  32. struct {
  33.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  34.         sfactr;
  35.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  36.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  37. } status_;
  38.  
  39. #define status_1 status_
  40.  
  41. struct {
  42.     doublereal value[200000];
  43. } blank_;
  44.  
  45. #define blank_1 blank_
  46.  
  47. /* Table of constant values */
  48.  
  49. static integer c__1 = 1;
  50. static integer c__3 = 3;
  51. static integer c__4 = 4;
  52.  
  53. /*<       subroutine title(ifold,len,icom,coment) >*/
  54. /* Subroutine */ int title_(ifold, len, icom, coment)
  55. integer *ifold;
  56. integer *len, *icom;
  57. doublereal *coment;
  58. {
  59.     /* Format strings */
  60.     static char fmt_31[] = "(\0021\002,16(\002*\002),a8,1x,24(\002*\002),3a8\
  61. ,24(\002*\002),a8,16(\002*\002),//\0020\002,15a8/)";
  62.     static char fmt_36[] = "(\0020****\002,17x,4a8,21x,\002temperature =\002\
  63. ,f9.3,\002 deg c\002/)";
  64.     static char fmt_41[] = "(\0020\002,121(\002*\002)//)";
  65.     static char fmt_101[] = "(\0021\002,7(\002*\002),a8,1x,8(\002*\002),3a8,\
  66. 8(\002*\002),a8,5(\002*\002)//\0020\002,10a8/)";
  67.     static char fmt_106[] = "(\0020****     \002,4a8,\002 temperature =\002,\
  68. f9.3,\002 deg c\002/)";
  69.     static char fmt_111[] = "(\0020\002,71(\002*\002)//)";
  70.     static char fmt_161[] = "(\0020\002,3a8,/)";
  71.  
  72.     /* Builtin functions */
  73.     integer s_wsfe(), do_fio(), e_wsfe();
  74.  
  75.     /* Local variables */
  76.     static integer i;
  77. #define nodplc ((integer *)&blank_1)
  78. #define cvalue ((complex *)&blank_1)
  79.  
  80.     /* Fortran I/O blocks */
  81.     static cilist io__3 = { 0, 0, 0, fmt_31, 0 };
  82.     static cilist io__5 = { 0, 0, 0, fmt_36, 0 };
  83.     static cilist io__6 = { 0, 0, 0, fmt_41, 0 };
  84.     static cilist io__7 = { 0, 0, 0, fmt_101, 0 };
  85.     static cilist io__8 = { 0, 0, 0, fmt_106, 0 };
  86.     static cilist io__9 = { 0, 0, 0, fmt_111, 0 };
  87.     static cilist io__10 = { 0, 0, 0, fmt_106, 0 };
  88.     static cilist io__11 = { 0, 0, 0, fmt_161, 0 };
  89.  
  90.  
  91.     /* Parameter adjustments */
  92.     --coment;
  93.  
  94.     /* Function Body */
  95. /*<       implicit double precision (a-h,o-z) >*/
  96.  
  97. /*     this routine writes a title on the output file.  ifold indicates */
  98.  
  99. /* whether the page eject should be to the next concave, convex, or any */
  100.  
  101. /* page fold depending on whether its value is <0, >0, or =0.  the page */
  102.  
  103. /* eject is suppressed (as is much of the heading) if the variable nopage 
  104. */
  105. /* is nonzero. */
  106.  
  107. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  108. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  109. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  110. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  111. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  112. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  113. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  114. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  115. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  116. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  117. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  118. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  119. /* spice version 2g.6  sccsid=status 3/15/83 */
  120. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  121. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  122. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  123. /* spice version 2g.6  sccsid=blank 3/15/83 */
  124. /*<       common /blank/ value(200000) >*/
  125. /*<       integer nodplc(64) >*/
  126. /*<       complex cvalue(32) >*/
  127. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  128.  
  129.  
  130. /*<       dimension coment(4) >*/
  131.  
  132.  
  133. /*<       if(nopage.eq.1) go to 150 >*/
  134.     if (miscel_1.nopage == 1) {
  135.     goto L150;
  136.     }
  137.  
  138. /*<    30 if (len.le.80) go to 100 >*/
  139. /* L30: */
  140.     if (*len <= 80) {
  141.     goto L100;
  142.     }
  143. /*<       write (iofile,31) adate,aprog,atime,(atitle(i),i=1,10) >*/
  144.     io__3.ciunit = status_1.iofile;
  145.     s_wsfe(&io__3);
  146.     do_fio(&c__1, (char *)&miscel_1.adate, (ftnlen)sizeof(doublereal));
  147.     do_fio(&c__3, (char *)&miscel_1.aprog[0], (ftnlen)sizeof(doublereal));
  148.     do_fio(&c__1, (char *)&miscel_1.atime, (ftnlen)sizeof(doublereal));
  149.     for (i = 1; i <= 10; ++i) {
  150.     do_fio(&c__1, (char *)&miscel_1.atitle[i - 1], (ftnlen)sizeof(
  151.         doublereal));
  152.     }
  153.     e_wsfe();
  154. /*<    31 format(1h1,16(1h*),a8,1x,24(1h*),3a8,24(1h*),a8,16(1h*),//1h0, >*/
  155. /*<      1   15a8/) >*/
  156. /*<       if (icom.eq.0) go to 40 >*/
  157.     if (*icom == 0) {
  158.     goto L40;
  159.     }
  160. /*<       write (iofile,36) coment,value(itemps+itemno) >*/
  161.     io__5.ciunit = status_1.iofile;
  162.     s_wsfe(&io__5);
  163.     do_fio(&c__4, (char *)&coment[1], (ftnlen)sizeof(doublereal));
  164.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.itemps + status_1.itemno - 
  165.         1], (ftnlen)sizeof(doublereal));
  166.     e_wsfe();
  167. /*<    36 format(5h0****,17x,4a8,21x,'temperature =',f9.3,' deg c'/) >*/
  168. /*<    40 write (iofile,41) >*/
  169. L40:
  170.     io__6.ciunit = status_1.iofile;
  171.     s_wsfe(&io__6);
  172.     e_wsfe();
  173. /*<    41 format(1h0,121(1h*)//) >*/
  174. /*<       go to 200 >*/
  175.     goto L200;
  176.  
  177.  
  178. /*<   100 write (iofile,101) adate,aprog,atime,(atitle(i),i=1,10) >*/
  179. L100:
  180.     io__7.ciunit = status_1.iofile;
  181.     s_wsfe(&io__7);
  182.     do_fio(&c__1, (char *)&miscel_1.adate, (ftnlen)sizeof(doublereal));
  183.     do_fio(&c__3, (char *)&miscel_1.aprog[0], (ftnlen)sizeof(doublereal));
  184.     do_fio(&c__1, (char *)&miscel_1.atime, (ftnlen)sizeof(doublereal));
  185.     for (i = 1; i <= 10; ++i) {
  186.     do_fio(&c__1, (char *)&miscel_1.atitle[i - 1], (ftnlen)sizeof(
  187.         doublereal));
  188.     }
  189.     e_wsfe();
  190. /*<   101 format(1h1,7(1h*),a8,1x,8(1h*),3a8,8(1h*),a8,5(1h*)//1h0,10a8/) >*/
  191. /*<       if (icom.eq.0) go to 110 >*/
  192.     if (*icom == 0) {
  193.     goto L110;
  194.     }
  195. /*<       write (iofile,106) coment,value(itemps+itemno) >*/
  196.     io__8.ciunit = status_1.iofile;
  197.     s_wsfe(&io__8);
  198.     do_fio(&c__4, (char *)&coment[1], (ftnlen)sizeof(doublereal));
  199.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.itemps + status_1.itemno - 
  200.         1], (ftnlen)sizeof(doublereal));
  201.     e_wsfe();
  202. /*<   106 format(10h0****     ,4a8,' temperature =',f9.3,' deg c'/) >*/
  203. /*<   110 write (iofile,111) >*/
  204. L110:
  205.     io__9.ciunit = status_1.iofile;
  206.     s_wsfe(&io__9);
  207.     e_wsfe();
  208. /*<   111 format(1h0,71(1h*)//) >*/
  209. /*<       go to 200 >*/
  210.     goto L200;
  211.  
  212.  
  213. /*<   150 if (icom.eq.0) go to 160 >*/
  214. L150:
  215.     if (*icom == 0) {
  216.     goto L160;
  217.     }
  218. /*<       write (iofile,106) coment,value(itemps+itemno) >*/
  219.     io__10.ciunit = status_1.iofile;
  220.     s_wsfe(&io__10);
  221.     do_fio(&c__4, (char *)&coment[1], (ftnlen)sizeof(doublereal));
  222.     do_fio(&c__1, (char *)&blank_1.value[tabinf_1.itemps + status_1.itemno - 
  223.         1], (ftnlen)sizeof(doublereal));
  224.     e_wsfe();
  225. /*<       go to 200 >*/
  226.     goto L200;
  227. /*<   160 write (iofile,161) aprog >*/
  228. L160:
  229.     io__11.ciunit = status_1.iofile;
  230.     s_wsfe(&io__11);
  231.     do_fio(&c__3, (char *)&miscel_1.aprog[0], (ftnlen)sizeof(doublereal));
  232.     e_wsfe();
  233. /*<   161 format(1h0,3a8,/) >*/
  234.  
  235. /*  finished */
  236.  
  237. /*<   200 return >*/
  238. L200:
  239.     return 0;
  240. /*<       end >*/
  241. } /* title_ */
  242.  
  243. #undef cvalue
  244. #undef nodplc
  245.  
  246.  
  247.